;First, here is what's left of the file TAILOR
INTERN SLOF,LOCSM

SLOF:	SLOFIL
	SIXBIT	/REL/
	0↔0			;FOR LOW SEGMENT MODIFICATION

LOCSM:	LOCSYM			;TAILORS UP.FAI ROUTINES

;Next, UP.FAI, half TENEXized.
?SEGS←←1
?LOWER←←0
?UPPER←←1
?RENSW←←0			;NOT FOR MAKING A TENEX SEGMENT
IFNDEF GLOBSW,<↓GLOBSW←←0>
	TITLE UPPER
BEGIN UPPER1

A←←1
B←←2
C←←3
D←←4
E←←5

;START AT UPWRT
;this code doesnt quite work since the loader seems to
;put a lot of extra space at the end of the segment
;currently, FIRLOC+12 should have the value 670777,
;although it may increase

↑UPWRT:	JSYS 	RESET
UPGOT:	SETZM	FIRLOC+11	;NO 2D SEGMENT SYMBOL TABLE
	HLRZ	A,JOBSA		;DELETE SYMBOL TABLE
	MOVEI	A,-FIRLOC-1(A)
	HRRZM	A,ASIZ		;SIZE OF SEC. SEG. -1
	TRO	A,400000	;TURN IT OT.
	HRRZM	A,FIRLOC+12	;TOP2 WORD.....

;FIRST BLT THE SEGMENT INTO PLACE
;THEN SAVE IT AWAY WITH SSAVE
	MOVE A,[XWD FIRLOC,SEGPAG*1000]
	MOVE B, [BLT A ,]
	HRR	B,FIRLOC+12	;TOP2 WORD, COMPUTED ABOVE
	XCT B
GTSEG:	HRROI	A,[ASCIZ/
Type name for segment file,
assembled name is /]
	JSYS	PSOUT
	HRROI	A,[FILXXX]
	JSYS	PSOUT
	HRROI	A,[ASCIZ/
*/]
	JSYS	PSOUT
	HRLZI A,400003
	MOVE	B,[XWD 100,101]	;PRIMARY INPUT-OUTPUT
	JSYS GTJFN
	  JRST	[HRROI	A,[ASCIZ/
Can't GTJFN segment file, try again.
/]
		 JSYS 	PSOUT
		 JRST GTSEG]
	HRLI 1,400000		;THIS FORK
	MOVE 2,[XWD -40,520000+SEGPAG]
	SETZ 3,
	JSYS SSAVE
	JSYS RLJFN
	  JRST [HRROI	A,[ASCIZ/
Cant RLJFN segment.
/]
		JSYS	PSOUT
		JSYS HALTF]
COMMENT ⊗
 THE INTERNAL SYMBOLS FROM THIS UPPER SEGMENT WILL NOW BE
COPIED INTO THE LOWER SEGMENT .REL FILE, TO PROVIDE UPPER/LOWER
LINKAGES.  THIS ELIMINATES THE NEED FOR THE LOADER TO KNOW ANYTHING 
ABOUT STRANGE SAIL UPPER SEGMENTS
⊗

	INIT	1,14		;INPUT
	'DSK   '
	IBUF
	JRST	[	PRINT	<NO DISK TODAY>
			JSYS HALTF]
	SETZM	SLOF1+2
	SETZM	SLOF1+3
	LOOKUP	1,SLOF1		;GET SAILOW.REL OR SOMETHING
	JRST	[PRINT	<WHERE IS LOWER?>
		JSYS HALTF]

	INIT	2,14		;OUTPUT
	'DSK   '
	XWD	OBUF,0
	JRST	[PRINT	<NO DISK TODAY>
		JSYS HALTF]
	SETZM	SLOF+2
	SETZM	SLOF+3
	ENTER	2,SLOF		;PUT SAME
	JRST	[PRINT	<CAN'T MAKE NEW SAILOW>
		JSYS HALTF]
	HLRE	3,JOBSYM
	MOVMS	3
	HRRZ	2,JOBSYM
	ADD	2,3		;→PAST END OF SYMBOL TABLE
	HRRZM	2,JOBFF		;IF NO DDT, LOADER HAS WIPED SYMTAB
	INBUF	1,2
	OUTBUF	2,2
	HLLZS	SMTAB		;SOME INITIALIZATION (NOT MUCH)
FOR II←1,4 <
	JSP	1,COPY		;COPY FIRST FOUR WORDS (NAME BLOCK)
>
	LSH	3,-1		;#SYMBOLS
	MOVE	TEMP,[RADIX50 0,UPPER] ;LOOK FOR THIS PROGRAM
LP1:	CAMN	TEMP,(2)
	JRST	LOOP
	SUBI	2,2
	SOJG	3,LP1
	HALT			;DIDN'T FIND IT
LOOP:	SUBI	2,2		;BACK UP ONE ENTRY
	JSP	6,COPSYM	;COPY ONE ENTRY IF INTERNAL
	SOJG	3,LOOP		;GET ALL OF THEM
	JSP	6,FORSYM	;FORCE REMAINING OUT
	JSP	1,COPY		;COPY REST OF FILE
	JRST	.-1		;WILL NOT RETURN ON EOF

COPY:	SOSLE	IBUF+2		;INPUT ROUTINE
	JRST	OKIN
	INPUT	1,0		;SURELY YOU'VE SEEN THESE BEFORE?
	STATZ	1,20000		;EOF?
	CALLI	12		;YES, DONE
	STATZ	1,740000	;ERROR?
	JRST	[PRINT	<INPUT DATA ERROR IN SAILOW UPDATE>
		JSYS HALTF]
OKIN:	ILDB	4,IBUF+1	;GET ONE
OUTWD:	SOSG	OBUF+2		;OUTPUT ROUTINE
	OUTPUT	2,
	IDPB	4,OBUF+1
	JRST	(1)

COPSYM:	LDB	4,[POINT 4,(2),3] ;SYMBOL TYPE
	JUMPE	4,1(6)		;ANOTHER PROG, QUIT
	SKIPE	LOCSM		;LOAD ALL IF LOCAL SYMBOLS WANTED
	 JRST	 ALLTHM
	CAIE	4,1		;INTERNAL?
	JRST	(6)		;NO
	HRRZ	4,1(2)
	CAIGE	4,400000	;SECOND SEGMENT SYMBOL?
	JRST	(6)		;NO AGAIN
ALLTHM:	AOS	SMTAB		;MAKE ROOM FOR 2
	AOS	5,SMTAB
	HRRZS	5		;INDEX TO SYMBOL BLOCK
	MOVE	4,(2)
	MOVEM	4,SMTAB(5)
	MOVE	4,1(2)		;MAKE THE TRANSFERS
	MOVEM	4,SMTAB+1(5)
	CAIGE	5,22		;FULL?
	JRST	(6)		;NO, DONE
FORSYM:	HRRZ	5,SMTAB		;GET COUNT
	JUMPE	5,(6)		;RETURN IF EMPTY
	MOVNI	5,2(5)		;FOR BLOCK TYPE AND RELOC WORDS
	HRLS	5		;AOBJN PTR
	HRRI	5,SMTAB
OLP:	MOVE	4,(5)		;WORD TO GO OUT
	JSP	1,OUTWD		;OUT IT GOES
	AOBJN	5,OLP		;GET ALL
	HLLZS	SMTAB
	JRST	(6)		;THAT'S ALL
SMTAB:	XWD	2,0		;BLOCK TYPE (SYMBOLS)
	0			;NEVER RELOCATE THESE
	BLOCK	22		;ROOM FOR SYMBOLS

IBUF:	BLOCK	3
OBUF:	BLOCK	3

SLOF1:	SIXBIT	/LOWER/		;ALWAYS
	SIXBIT	/REL/		;LOWER FOR INPUT
	0↔0

DUMPR:	BLOCK	2
	ASIZ:	0
	AONE:	XWD FIRLOC,SEGPAG*1000

	LIT
FIRLOC:

BEND UPPER1
↓%FIRLOC:
PHASE SEGPAG*1000	;MAGIC ....
	REPEAT 11,<-1>	;REMAIN COMPATIBLE (?) WITH DEC -- 10 WORD.
	0		;400011 -- JOBSYM POINTER.
↓TOP2:	0		;400012 -- TOP SEC SEG ADDRESS.

INTERNAL %ALLOC